VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFont"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'====================================================================================
'clsFont - Stores a bitmap font used in the game
'====================================================================================
'NOTE: Please be careful when editing this page. This same class is used both in
'      the game and the level editor.
Option Explicit

'The fonts in Pac Mar are stored as 32bit TGA files with all the letters in a line,
'in ASCII order (32 onwards). A secondary file contains the width of each letter in
'the same order and these two files are loaded to provide the lettering in Pac Mar.

' !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~

'Each font can have multiple "styles", stacked one on top of the other. Each style
'however must have the same letter width and overal height as the others. This is
'used to provide the menu normal / hover states in Pac Mar

'------------------------------------------------------------------------------------
Private Buffer As New ImageTGA   'The 32bit TGA image of the font
Private Type PM_LETTER
    Left As Long   'Where each letter is in the large bitmap
    Width As Long  'The width of each letter
End Type
Private Letters(94) As PM_LETTER
Private StyleCount As Long       'Number of styles in the font
Private MyLetterHeight As Long   'Height of a single style

'GET LetterHeight: Height of font letters, not height of image due to styles
'====================================================================================
Public Property Get LetterHeight() As Long: LetterHeight = MyLetterHeight: End Property

'====================================================================================
'LoadFont: Load an image in, and its paired letter position file
'====================================================================================
Public Sub Load(ByVal FontPath As String)
    Dim K As Long, Left As Long
    Dim KeyName As String
    
    'Load the image of the font letters
    Buffer.LoadTGA32 FontPath & ".tga"
    
    'Load the position file
    Open (FontPath & ".dat") For Input As #1
        'Get the number of styles
        Input #1, StyleCount
        MyLetterHeight = Buffer.Height \ StyleCount
        'The next set of numbers are the width of each letter, in ASCII order (32+)
        K = 0: Do While EOF(1) = False
            'Before each width is a key name that only serves as a comment
            Input #1, KeyName
            'Read in the width of one letter
            Input #1, Letters(K).Width
            'The position of the letter in the bitmap
            Letters(K).Left = Left
            'Move onto the next letter
            Left = Left + Letters(K).Width: K = K + 1
        Loop
    Close #1
End Sub

'====================================================================================
'DrawText: Draw a message in the font on a surface
'====================================================================================
Public Function DrawText(ByVal hDC As Long, ByVal DestLeft As Long, ByVal DestTop As Long, ByVal Text As String, Optional ByVal Style As Long = 1) As Long
    Dim K As Long, tASC As Byte
    
    'Start drawing the letters of the message
    For K = 1 To Len(Text)
        'Space is 32 on the ASCII chart and the font graphics starts with space
        'and continues with the characters in ASCII order. See www.asciichart.com
        tASC = Asc(Mid(Text, K, 1)) - 32
        'Draw the letter onto the statusbar
        Buffer.DrawEx _
                   hDC:=hDC, _
              DestLeft:=(DestLeft + DrawText), _
               DestTop:=DestTop, _
             DestWidth:=Letters(tASC).Width, _
            DestHeight:=MyLetterHeight, _
               SrcLeft:=Letters(tASC).Left, _
                SrcTop:=(Style - 1) * MyLetterHeight
        
        'Move onto the next letter, and total up the width of the message
        DrawText = DrawText + Letters(tASC).Width
    Next K
End Function

'====================================================================================
'GetTextWidth: Work out how wide a message would be in a font
'====================================================================================
Public Function GetTextWidth(ByVal MessageText As String) As Long
    Dim K As Long, Letter As Byte
    
    'Loop through each letter
    For K = 1 To Len(MessageText)
        'Get the letter in question
        Letter = Asc(Mid(MessageText, K, 1)) - 32
        'Add to total width
        GetTextWidth = GetTextWidth + Letters(Letter).Width
    Next K
End Function

'====================================================================================
'CLASS Terminate: When the font is unloaded
'====================================================================================
Private Sub Class_Terminate()
    'Free up memory
    Erase Letters
    Set Buffer = Nothing
End Sub

'=== END ============================================================================
'This work is licenced under the Creative Commons Attribution 2.5 License
